home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok88 / arexxbox / oberon / txt / arbrexxhost.mod
Text File  |  1993-11-04  |  12KB  |  432 lines
  1. (*************************************************************************
  2.  
  3. :Program.    ARBRexxHost.mod
  4. :Contents.   simple rexx interface for use with ARexxBox
  5. :Author.     Hartmut Goebel [hG]
  6. :Copyright.  Copyright © 1990 by Hartmut Goebel
  7. :Copyright.  original 'C' definitions copyright © 1990 by Michael Balzer
  8. :Language.   Oberon-2
  9. :Translator. Amiga Oberon V3.01
  10. :History.    V1.0, 31 Aug 1992 [hG]
  11. :History.    V1.02 24 Oct 1992 [hG]
  12. :Date.       25 Dec 1992 17:40:11
  13.  
  14. *************************************************************************)
  15.  
  16. (* $StackChk- $NilChk- $RangeChk- $CaseChk- $OvflChk- $ReturnChk- $ClearVars- *)
  17.  
  18. MODULE ARBRexxHost;
  19.  
  20. IMPORT
  21.   BT := BasicTypes,
  22.   e  := Exec,
  23.   d  := Dos,
  24.   ms := MoreStrings,
  25.   pf := Printf,
  26.   rx := Rexx,
  27.   rxs:= RexxSysLib,
  28.   rxh:= RexxHost,
  29.   y  := SYSTEM,
  30.   str:= Strings;
  31.  
  32. TYPE
  33.   RexxHost * = POINTER TO RexxHostDesc;
  34.   RexxHostDesc * = RECORD (rxh.RexxHost)
  35.     rdargs   -: d.RDArgsPtr;
  36.     flags    *: LONGSET;
  37.     userdata *: e.APTR;
  38.   END;
  39.  
  40. CONST
  41.   (* RexxHost.flags *)
  42.   cmdShell * = 0;
  43.  
  44. TYPE
  45.   ResLong        * = POINTER TO ARRAY 1 OF LONGINT;
  46.   ResLongArray   * = POINTER TO ARRAY OF LONGINT;
  47.   ResBool        * = LONGINT;
  48.   ResString      * = BT.DynString;
  49.   ResStringArray * = POINTER TO ARRAY OF ResString;
  50.  
  51.   (* these are UNTRACED 'cause allocated by DOS *)
  52.   ArgLong        * = UNTRACED POINTER TO ARRAY 1 OF LONGINT;
  53.   ArgLongArray   * = UNTRACED POINTER TO ARRAY d.maxMultiArgs OF ArgLong;
  54.   ArgBool        * = LONGINT;
  55.   ArgString      * = e.STRPTR;
  56.   ArgStringArray * = UNTRACED POINTER TO ARRAY d.maxMultiArgs OF ArgString;
  57.  
  58. CONST
  59.   (* better check for # LFALSE then = LTRUE due to AmigaDOS reasons *)
  60.   LFALSE * = d.DOSFALSE;
  61.   LTRUE  * = d.DOSTRUE;
  62.  
  63. TYPE
  64.   RXDPtr * = POINTER TO RXD;
  65.   RXD * = RECORD
  66.     rc *, rc2 *: LONGINT;
  67.   END;
  68.  
  69. CONST
  70.   (* Die Msg-Typen für die Interfacefunktionen *)
  71.   init   * = 1;
  72.   action * = 2;
  73.   free   * = 3;
  74.  
  75. TYPE
  76.   HostFunction * = PROCEDURE (    host: RexxHost;
  77.                               VAR data: RXDPtr;
  78.                                   action: INTEGER);
  79.  
  80.   CommandPtr * = UNTRACED POINTER TO Command;
  81.   Command * = STRUCT
  82.     command *, args *, results *: e.STRPTR;
  83.     resindex *: LONGINT;
  84.     function *: HostFunction;
  85.     flags    *: LONGSET;
  86.   END;
  87.  
  88. CONST
  89.   (* Command.flags *)
  90.   enabled  * = 0;
  91.  
  92.   (* error codes and texts *)
  93.   (* change it to your needs *)
  94.   CommandDisabled * = "Command disabled";
  95.   CantSetVar * = "Unable to set Rexx variable";
  96.  
  97.   errorNoFreeStore * = rx.err10003;
  98.   errorNotImplemented * = rx.err10015;
  99.  
  100. TYPE
  101.   StemNodePtr * = POINTER TO StemNode;
  102.   StemNode = STRUCT
  103.     succ -: StemNodePtr;
  104.     name -, value -: BT.DynString;
  105.   END;
  106.  
  107. PROCEDURE (host: RexxHost) Uninit *;
  108. BEGIN
  109.   IF host.rdargs # NIL THEN
  110.     d.FreeDosObject(d.rdArgs, host.rdargs);
  111.   END;
  112.   host.Uninit^();
  113. END Uninit;
  114.  
  115.  
  116. PROCEDURE Init * (host: RexxHost;
  117.                   basename: e.STRPTR; (* $CopyArrays- *)
  118.                   default: ARRAY OF CHAR;
  119.                   extension: ARRAY OF CHAR): BOOLEAN;
  120. BEGIN
  121.   IF rxh.Init(host^,basename,default,extension) THEN
  122.     host.rdargs := d.AllocDosObject(d.rdArgs,NIL);
  123.     IF host.rdargs = NIL THEN
  124.       host.Uninit;
  125.       RETURN FALSE;
  126.     END;
  127.  
  128.     host.rdargs.flags := LONGSET{d.noPrompt};
  129.     RETURN TRUE;
  130.   END;
  131.   RETURN FALSE;
  132. END Init;
  133.  
  134.  
  135. PROCEDURE (host: RexxHost) FindCommand * (com: ARRAY OF CHAR): INTEGER;
  136. BEGIN HALT(20); END FindCommand;
  137.  
  138.  
  139. PROCEDURE (host: RexxHost) ParseCommand * (VAR arg: e.STRPTR): INTEGER;
  140. VAR
  141.   com: e.STRING;
  142.   i: INTEGER;
  143. BEGIN
  144.   i := 0;
  145.   LOOP
  146.     IF i >= SIZE(com) THEN EXIT; END;
  147.     CASE arg[i] OF
  148.     CHR(0), " ", "\n": EXIT;
  149.     ELSE END;
  150.     com[i] := arg[i]; INC(i);
  151.   END;
  152.   com[i] := CHR(0);
  153.   WHILE arg[i] = " " DO INC(i); END;
  154.   arg := y.ADR(arg[i]);
  155.   RETURN host.FindCommand(com);
  156. END ParseCommand;
  157.  
  158. TYPE
  159.   DoubleStr = ARRAY 512 OF CHAR;
  160.   DoubleStrPtr = UNTRACED POINTER TO DoubleStr;
  161.  
  162.  
  163. PROCEDURE (rxh: RexxHost) HandleShellCommand * (comline: ARRAY OF CHAR;
  164.                                               fhout: d.FileHandlePtr);
  165. BEGIN HALT(20) END HandleShellCommand;
  166.  
  167.  
  168. PROCEDURE (host: RexxHost) CommandShell * (fhin, fhout: d.FileHandlePtr;
  169.                                           prompt: ARRAY OF CHAR);
  170. VAR
  171.   i : INTEGER;
  172.   in: DoubleStrPtr;
  173.   rm: rx.RexxMsgPtr;
  174.   comLine: DoubleStr;
  175. BEGIN
  176.   IF fhin = NIL THEN
  177.     RETURN; END;
  178.   INCL(host.flags,cmdShell); (* auf diesem Port läuft eine CommandShell *)
  179.  
  180.   REPEAT
  181.     IF (fhout # NIL) & (prompt # "") (* Prompt ausgeben *)
  182.       & d.FPuts(fhout, prompt) THEN END;
  183.  
  184.     in := d.FGets(fhin, comLine, SIZE(comLine));
  185.     IF in # NIL THEN
  186.       i := 0;
  187.       WHILE (i < SIZE(comLine)) & ((in[0] = " ") OR (in[0] = "\t")) DO
  188.         INC(i); in := y.ADR(in[1]); END;
  189.       IF (i < SIZE(comLine)) & (in[0] # "\n") THEN
  190.         host.HandleShellCommand( in^, fhout ); END;
  191.     ELSE
  192.       EXCL(host.flags,cmdShell); (* CommandShell Ende *)
  193.     END;
  194.  
  195.     (* Port des Hosts leeren (asynchrone Replies) *)
  196.     LOOP
  197.       rm := e.GetMsg(host.port);
  198.       IF rm = NIL THEN EXIT; END;
  199.       IF rm.node.node.type = e.replyMsg THEN (* Reply? *)
  200.         host.FreeCommand(rm);
  201.         DEC(host.replies);
  202.       (* sonst Kommando . Fehler *)
  203.       ELSE
  204.         host.ReplyMsg( rm, -20, y.ADR("CommandShell Port"), NIL );
  205.       END;
  206.     END;
  207.   UNTIL ~(cmdShell IN host.flags);
  208. END CommandShell;
  209.  
  210. (* ---------------------------------------------------------------- *)
  211. (* --- methods and procs for STEM and VAR handling  --------------- *)
  212.  
  213. (* Diese Funktion setzt aus der StemListe (s.u.) eine einzelne Variable
  214.  * zusammen indem sie alle Resultate durch Spaces getrennt hintereinanderkopiert.
  215.  *)
  216. PROCEDURE CreateVAR * (stem: StemNodePtr): BT.DynString;
  217. VAR
  218.   var: BT.DynString;
  219.   sn: StemNodePtr;
  220.   size: LONGINT;
  221. BEGIN
  222.   IF (stem = NIL) THEN RETURN NIL; END;
  223.   size := 0;
  224.   sn := stem;
  225.   REPEAT
  226.     INC(size,str.Length(sn.value^)+1);
  227.     sn := sn.succ;
  228.   UNTIL sn = NIL;
  229.   y.ALLOCATE(var,size+1);
  230.   IF (var = NIL) THEN RETURN NIL END;
  231.   var^ := "";
  232.   sn := stem;
  233.   REPEAT
  234.     str.Append(var^,sn.value^);
  235.     IF sn.succ # NIL THEN
  236.       str.AppendChar(var^," "); END;
  237.     sn := sn.succ;
  238.   UNTIL sn = NIL;
  239.   RETURN var;
  240. END CreateVAR;
  241.  
  242.  
  243. PROCEDURE FreeStemList * (VAR first: StemNodePtr);
  244. (* $IF GarbageCollector *)
  245. BEGIN
  246.   first := NIL;
  247. (* $ELSE *)
  248. VAR
  249.   next: StemNodePtr;
  250. BEGIN
  251.   WHILE first # NIL DO
  252.     next := first.succ;
  253.     DISPOSE(first.name);
  254.     DISPOSE(first.value);
  255.     DISPOSE(first);
  256.     first := next;
  257.   END;
  258. (* $END *)
  259. END FreeStemList;
  260.  
  261.  
  262. (* Diese Funktion generiert die StemListe anhand der
  263.  * Resultate und der Resultatschablone des Kommandos
  264.  *)
  265. PROCEDURE CreateSTEM * (rxc: CommandPtr;
  266.                    resarray: UNTRACED POINTER TO ARRAY MAX(INTEGER) OF LONGINT;
  267.                    stembase: e.STRPTR): StemNodePtr;
  268. VAR
  269.   first, old, new: StemNodePtr;
  270.   rs, rb, t, wordCnt: INTEGER;
  271.   optn, optm: BOOLEAN;
  272.   longbuff: ARRAY 16 OF CHAR;
  273.   resb: ARRAY 512 OF CHAR;
  274. CONST
  275.   ResLongWords = SIZE(ResLong) DIV SIZE(LONGINT);
  276.   DynStrWords  = SIZE(BT.DynString) DIV SIZE(LONGINT);
  277. TYPE
  278.   ValueDummy = UNTRACED POINTER TO ValueDummyDesc;
  279.   ValueDummyDesc = STRUCT END;
  280.   NumValue = STRUCT (d: ValueDummyDesc)
  281.     num: ResLong;
  282.   END;
  283.   StringValue = STRUCT (d: ValueDummyDesc)
  284.     str: BT.DynString;
  285.   END;
  286.  
  287.   PROCEDURE NewStemNode (): StemNodePtr;
  288.   VAR
  289.     new: StemNodePtr;
  290.   BEGIN
  291.     y.ALLOCATE(new);
  292.     IF new = NIL THEN RETURN NIL; END;
  293.     IF old # NIL THEN
  294.       old.succ := new; old := new;
  295.     ELSE
  296.       first := new; old := new;
  297.     END;
  298.     RETURN new;
  299.   END NewStemNode;
  300.  
  301.   PROCEDURE GetValue (value: ValueDummy; deref: BOOLEAN; VAR cnt: INTEGER): BT.DynString;
  302.   (* deref tells, wether /N are ResLong or LONGINT *)
  303.   TYPE
  304.     SingleNumValue = STRUCT (d: ValueDummyDesc)
  305.       num: LONGINT;
  306.     END;
  307.   BEGIN
  308.     IF optn THEN (* numerisch *)
  309.       IF ~ deref THEN (* direkt values, no pointers *)
  310.         INC(cnt);
  311.         pf.SPrintf1( longbuff, "%ld", value(SingleNumValue).num);
  312.       ELSE
  313.         INC(cnt,ResLongWords);
  314.         pf.SPrintf1( longbuff, "%ld", value(NumValue).num^[0]);
  315.       END;
  316.       RETURN ms.CopyString(longbuff);
  317.     ELSE (* string *)
  318.       INC(cnt,DynStrWords);
  319.       RETURN ms.CopyString(value(StringValue).str^);
  320.     END;
  321.   END GetValue;
  322.  
  323.   PROCEDURE CreateResultList(value: ValueDummy): BOOLEAN;
  324.   VAR
  325.     mWordCnt, index: INTEGER;
  326.     len: LONGINT;
  327.     countnd: StemNodePtr;
  328.     tt: e.STRPTR;
  329.   TYPE
  330.     LArrayVal = UNTRACED POINTER TO STRUCT (d: ValueDummyDesc)
  331.       arr: UNTRACED POINTER TO ARRAY OF ResLong;
  332.     END;
  333.     DStrArrayVal = UNTRACED POINTER TO STRUCT (d: ValueDummyDesc)
  334.       arr: UNTRACED POINTER TO ARRAY OF BT.DynString;
  335.     END;
  336.     WordValue = UNTRACED POINTER TO STRUCT (d: ValueDummyDesc)
  337.       arr: ARRAY MAX(INTEGER) OF LONGINT;
  338.     END;
  339.  
  340.   BEGIN
  341.     tt := y.ADR(resb[t]);
  342.     INC(wordCnt);
  343.     new := NewStemNode(); (* Node für die Anzahl der Elemente erzeugen *)
  344.     IF new = NIL THEN     (* ausgefüllt wird sie erst nach dem Listenbau! *)
  345.       RETURN FALSE; END;
  346.     countnd := new;
  347.     IF optn THEN len := LEN(value(LArrayVal).arr^);
  348.     ELSE len := LEN(value(DStrArrayVal).arr^);
  349.     END;
  350.     index := 0; mWordCnt := 0;
  351.     WHILE index < len DO
  352.       new := NewStemNode();
  353.       IF new = NIL THEN
  354.         RETURN FALSE; END;
  355.       pf.SPrintf1( tt^, ".%ld", index); (* Index an den Stem-Namen anhängen *)
  356.       new.name := ms.CopyString(resb);
  357.       new.value := GetValue(y.ADR(value(WordValue).arr[mWordCnt]),FALSE,mWordCnt);
  358.       INC(index);
  359.     END;
  360.     tt^ := ".COUNT"; (* Die Count-Node (erste, s.o.) ausfüllen *)
  361.     countnd.name := ms.CopyString( resb );
  362.     pf.SPrintf1( longbuff, "%ld", index );
  363.     countnd.value := ms.CopyString( longbuff );
  364.   END CreateResultList;
  365.  
  366.   PROCEDURE isResultHere (value: ValueDummy; VAR cnt: INTEGER): BOOLEAN;
  367.   BEGIN
  368.     IF optn & (value(NumValue).num = NIL) THEN
  369.       INC(cnt,ResLongWords);
  370.       RETURN FALSE;
  371.     ELSIF (value(StringValue).str = NIL) THEN
  372.       INC(cnt,DynStrWords);
  373.       RETURN FALSE;
  374.     END;
  375.     RETURN TRUE;
  376.   END isResultHere;
  377.  
  378. BEGIN
  379.   first := NIL; old := NIL;
  380.   wordCnt := 0;
  381.   IF stembase # NIL THEN (* Präfix einbauen *)
  382.     COPY(stembase^,resb); rb := SHORT(str.Length(resb));
  383.   ELSE
  384.     resb := ""; rb := 0;
  385.   END;
  386.   rs := 0;
  387.  
  388.   (* Liste aufbauen *)
  389.   WHILE rxc.results[rs] # CHR(0) DO
  390.     t := rb; optn := FALSE; optm := FALSE;
  391.     WHILE (rxc.results[rs] # CHR(0)) & (rxc.results[rs] # ",") DO
  392.       IF rxc.results[rs] = "/" THEN
  393.         INC(rs);
  394.         CASE rxc.results[rs] OF
  395.           "N": optn := TRUE;
  396.         | "M": optm := TRUE;
  397.         ELSE END;
  398.       ELSE
  399.         resb[t] := CAP(rxc.results[rs]); INC(t); (* Resultatnamen kopieren *)
  400.       END;
  401.       INC(rs);
  402.     END;
  403.     IF rxc.results[rs] = "," THEN INC(rs); END;
  404.     resb[t] := CHR(0);
  405.  
  406.     (* hier ist nun der Basisname der Stem-Variable in resb,
  407.      * und t zeigt in resb auf die Stelle, an der nun ggf. die
  408.      * Stem-Erweiterungen (.COUNT, .0 - .n) angehängt werden
  409.      *)
  410.     IF optm THEN (* /M war im Namen, also Liste *)
  411.       IF ~ CreateResultList(y.ADR(resarray[wordCnt])) THEN
  412.         FreeStemList(first);
  413.         RETURN NIL;
  414.       END;
  415.     ELSE (* keine Liste *)
  416.       IF isResultHere(y.ADR(resarray[wordCnt]),wordCnt) THEN
  417.         new := NewStemNode();
  418.         IF new = NIL THEN
  419.           FreeStemList(first);
  420.           RETURN NIL;
  421.         END;
  422.         new.name := ms.CopyString(resb);
  423.         new.value := GetValue(y.ADR(resarray[wordCnt]),TRUE,wordCnt);
  424.       END;
  425.     END;
  426.   END;
  427.   RETURN first;
  428. END CreateSTEM;
  429.  
  430. END ARBRexxHost.
  431.  
  432.